home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
picalc06.zip
/
PICALC.BAS
next >
Wrap
BASIC Source File
|
1993-06-08
|
12KB
|
338 lines
REM -PROGRAM : PICALC -----------------------------------------------
REM | FUNCTION: COMPUTES THE VALUE OF PI FROM RANDOM NUMBER GENERATOR |
REM | |
REM | STATUS : PUBLIC DOMAIN |
REM | |
REM | BY : TOM TAYLOR |
REM | SIGMA SOFTWARE |
REM | 50 Bret Avenue |
REM | San Rafael, CA 94901 |
REM | Ph: (415) 457-1071 |
REM | |
REM -----------------------------------------------------------------
REM
PgmName$ = "PICALC"
PgmVers$ = "0.6"
PgmDate$ = "03/21/93"
CLS : PRINT "CALCULATION OF PI FROM RANDOM NUMBERS"
PRINT
PRINT "PROGRAM: "; PgmName$; " VERS: "; PgmVers$; " DATE: "; PgmDate$
PRINT
PRINT "This program will only terminate in Two ways"
PRINT " 1. It reaches the Max Number of Iterations (2,147,483,647)."
PRINT " 2. You get sick of running it and press the <ESC> key."
PRINT
PRINT "In either case, the program will print the accumulated value of"
PRINT "PI at that time and end the run with an appropriate message."
PRINT "If the PRINT option is on, this final sample WILL be printed."
PRINT
PRINT "You may SAMPLE the number of Iterations and the Value of PI"
PRINT "by hitting any key (other than the <ESC> key) at any time."
PRINT "If the PRINT Option is on, this sample will NOT be printed."
PRINT
PRINT
PRINT "Hit <ANY-KEY> to continue ....";
INPUT z$: REM wait till user ready
REM *******************************************************************
REM *** PROGRAM CONSTANTS, ETC ***
REM *******************************************************************
AbsMax& = 2147483647: REM ABSOLUTE LIMIT OF PRECISION
TruePi# = 3.14159265358979#: REM value of PI to precision
Fuzz# = 5E-14: REM fuzz for single to double
Hits& = 0: REM hits in sector
SampType% = 1: REM default to magnitude
SampChg% = 10: REM default to 10
SampNext& = 1: REM iteration for next sample
SampPrt% = 0: REM printer switch 0=off, 1=on
ItMask$ = "##,###,###,###": REM iteration mask
DPMask$ = "####.#######": REM delta percent mask
REM *******************************************************************
REM *** MAIN MENU AND OPTIONS PROCESSING ***
REM *******************************************************************
MainMenu:
CLS
PRINT " PI CALCULATION - MAIN MENU"
PRINT
PRINT "1. AUTOMATIC SAMPLING INTERVAL DEFINITION = ";
PRINT MID$("NONE MAGNITUDEMULTIPLES", (SampType% * 9) + 1, 9)
PRINT " - NONE for NO samples"
PRINT " - MAG for samples by magnitude"
PRINT " i.e samples at 10, 100, 1000, 10000, ...."
PRINT " - MUL for samples on multiples"
PRINT " i.e samples at 100, 200, 300, 400, ...."
SELECT CASE SampType%
CASE IS = 1
PRINT "2. MAGNITUDE ";
CASE IS = 2
PRINT "2. MULTIPLE ";
CASE ELSE
END SELECT
IF SampType% > 0 THEN
PRINT "CHANGE FOR AUTOMATIC SAMPLES = "; SampChg%
PRINT "3. AUTOMATIC SAMPLES TO PRINTER <Y|N> = ";
PRINT MID$("NO YES", (SampPrt% * 3) + 1, 3)
END IF
PRINT
PRINT "0. BEGIN RUN"
PRINT
PRINT " SELECT BY NUMBER ====> "
REM *******************************************************************
REM *** GET MENU ITEM TO BE CHANGED ***
REM *******************************************************************
z$ = ""
DO WHILE z$ = ""
z$ = INKEY$
LOOP
z$ = UCASE$(z$)
SELECT CASE z$
CASE IS = "0"
GOTO SetUpRun
CASE IS = "1"
ErrFlg% = 1: REM assume an error
DO
CLS
PRINT "CHANGE TO AUTOMATIC SAMPLING TYPE "
PRINT " ENTER - NONE FOR NO AUTOMATIC SAMPLES"
PRINT " MAG FOR MAGNITUDE CHANGES"
PRINT " MUL FOR MULTIPLE CHANGES"
PRINT " <ENTER> TO KEEP PRESENT VALUE"
PRINT
PRINT "CURRENT VALUES IS ";
z% = (SampType% * 4) + 1
PRINT MID$("NONEMAG MUL ", z%, 4);
PRINT ", ENTER NEW VALUE ";
INPUT temp$
temp$ = LEFT$(UCASE$(temp$), 3)
SELECT CASE temp$
CASE IS = ""
ErrFlg% = 0
CASE IS = "NON"
SampType% = 0
SampPrt% = 0
ErrFlg% = 0
CASE IS = "MAG"
SampType% = 1
ErrFlg% = 0
CASE IS = "MUL"
SampType% = 2
ErrFlg% = 0
CASE ELSE
END SELECT
LOOP WHILE ErrFlg% = 1
CASE IS = "2"
IF SampType% = 0 THEN
CLS
PRINT "INVALID ENTRY FROM MAIN MENU": REM no sampling
SLEEP 15
GOTO MainMenu
END IF
ErrFlg% = 1
DO
CLS
PRINT "AUTOMATIC SAMPLES BY ";
SELECT CASE SampType%
CASE IS = 1
PRINT "MAGNITUDE"
PRINT " Suggest a power of 2 or a power of 10"
PRINT " Acceptable values are 2 thru 32,767"
PRINT " The iteration number of the previous ";
PRINT "sample will be MULTIPLIED by this value."
PRINT
PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
PRINT
PRINT "CURRENT VALUE IS "; SampChg%;
PRINT ", ENTER NEW VALUE ";
INPUT temp$
IF (VAL(temp$) > 1) AND (VAL(temp$) < 32768) THEN
SampChg% = VAL(temp$)
ErrFlg% = 0
ELSE
IF LEN(temp$) = 0 THEN
ErrFlg% = 0
END IF
END IF
CASE IS = 2
PRINT "MULTIPLES"
PRINT " Suggest a multiple of a power of 10"
PRINT " Acceptable values are 1 thru 32767"
PRINT " This value will be ADDED to the ";
PRINT "iteration number of the previous sample."
PRINT
PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
PRINT
PRINT "CURRENT VALUE IS "; SampChg%;
PRINT ", ENTER NEW VALUE ";
INPUT temp$
IF (VAL(temp$) > 0) AND (VAL(temp$) < 32768) THEN
SampChg% = VAL(temp$)
ErrFlg% = 0
ELSE
IF LEN(temp$) = 0 THEN
ErrFlg% = 0
END IF
END IF
END SELECT
LOOP WHILE ErrFlg% = 1
CASE IS = "3"
IF SampType% = 0 THEN
CLS
PRINT "INVALID ENTRY FROM MAIN MENU": REM no samples
SLEEP 15
GOTO MainMenu
END IF
ErrFlg% = 1
DO
CLS
PRINT "AUTOMATIC SAMPLES (as well as the final one) ";
PRINT "TO THE PRINTER OPTION"
PRINT "ENTER Y (for yes), or N (for no)"
PRINT
PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
PRINT
PRINT "CURRENT VALUE IS ";
PRINT MID$("NO YES", (SampPrt% * 3) + 1, 3);
PRINT ", ENTER NEW VALUE ";
INPUT temp$
temp$ = LEFT$(UCASE$(temp$), 1)
SELECT CASE temp$
CASE IS = ""
ErrFlg% = 0
CASE IS = "N"
SampPrt% = 0
ErrFlg% = 0
CASE IS = "Y"
SampPrt% = 1
ErrFlg% = 0
CASE ELSE
END SELECT
LOOP WHILE ErrFlg% = 1
END SELECT
GOTO MainMenu
REM *******************************************************************
REM *** SET UP FOR THE RUN ***
REM *******************************************************************
SetUpRun:
SELECT CASE SampType%
CASE IS = 0
SampNext& = AbsMax&
CASE IS = 1
SampNext& = 1
CASE IS = 2
SampNext& = SampChg%
END SELECT
CLS
PRINT " PI COMPUTATION BEGINNING - ON "; DATE$; " AT "; TIME$
PRINT " ITERATIONS COMPUTED VALUE OF PI DELTA %"
VIEW PRINT 3 TO 23
IF SampPrt% = 1 THEN
LPRINT "PROGRAM: "; PgmName$; " VERS: "; PgmVers$;
LPRINT " DATE: "; PgmDate$
LPRINT " PI COMPUTATION BEGINNING - ON "; DATE$; " AT "; TIME$
LPRINT " ITERATIONS COMPUTED VALUE OF PI DELTA %"
END IF
RANDOMIZE TIMER
REM *******************************************************************
REM *** MAIN COMPUTATION LOOP ***
REM *******************************************************************
MainLoop:
FOR tries& = 1 TO AbsMax&
X = RND(1)
X2# = (X * X) - Fuzz#
Y = RND(1)
Y2# = (Y * Y) - Fuzz#
r# = SQR(X2# + Y2#) - Fuzz#: REM vector to point(X,Y)
SELECT CASE r#
CASE IS < 1#
Hits& = Hits& + 1: REM In the Arc
GOTO CheckPrint
CASE IS > 1#
GOTO CheckPrint: REM Outside the Arc
CASE ELSE
IF (tries& MOD 2) > 0 THEN
Hits& = Hits& + 1
END IF
GOTO CheckPrint: REM Flip a Coin
END SELECT
CheckPrint:
Q$ = "": Q$ = INKEY$: IF Q$ <> "" THEN GOTO PrintValues
IF tries& < SampNext& THEN
GOTO LoopAgain: REM KEEP ON TRUCKING
END IF
PrintValues:
PI# = 4 * (Hits& / tries&): REM PI IS PROPORTIONAL TO NR OF HITS
DeltaPct = 100 * ((PI# - TruePi#) / TruePi#)
PRINT USING (ItMask$); tries&;
PRINT SPC(8); PI#;
PRINT TAB(48); USING (DPMask$); DeltaPct
IF (SampPrt% = 1) AND ((Q$ = "") OR (Q$ = CHR$(27))) THEN
LPRINT USING (ItMask$); tries&;
LPRINT SPC(8); PI#;
LPRINT TAB(48); USING (DPMask$); DeltaPct
END IF
IF Q$ = "" THEN
SELECT CASE SampType%
CASE IS = 1
IF (AbsMax& / SampNext&) > SampChg% THEN
SampNext& = SampNext& * SampChg%
ELSE
SampNext& = AbsMax&
END IF
CASE IS = 2
IF (AbsMax& - SampNext&) > SampChg% THEN
SampNext& = SampNext& + SampChg%
ELSE
SampNext& = AbsMax&
END IF
END SELECT
GOTO LoopAgain
END IF
IF Q$ = CHR$(27) THEN
PRINT "TERMINATED BY REQUEST - ON "; DATE$; " AT "; TIME$
IF SampPrt% = 1 THEN
LPRINT "TERMINATED BY REQUEST - ON "; DATE$; " AT "; TIME$
LPRINT CHR$(12)
END IF
END
END IF
LoopAgain:
NEXT tries&
PRINT "TERMINATED AT LIMIT OF PRECISION - ON ";
PRINT DATE$; " AT "; TIME$
IF SampPrt% = 1 THEN
LPRINT "TERMINATED AT LIMIT OF PRECISION - ON ";
LPRINT DATE$; " AT "; TIME$
LPRINT CHR$(12)
END IF
END